home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s1.arc / GETUPLOA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-03  |  6.3 KB  |  182 lines
  1. (*----------------------------------------------------------------------*)
  2. (*       Get_Upload_Protocol --- Get Upload File Transfer Protocol      *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION Get_Upload_Protocol : Transfer_Type ;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Function:   Get_Upload_Protocol                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Gets file name and transfer protocol for upload.     *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Transtyp := Get_Upload_Protocol: Transfer_Type;               *)
  16. (*                                                                      *)
  17. (*     Remarks:                                                         *)
  18. (*                                                                      *)
  19. (*     Calls:    KeyPressed                                             *)
  20. (*               Async_Send                                             *)
  21. (*               Async_Receive                                          *)
  22. (*                                                                      *)
  23. (*----------------------------------------------------------------------*)
  24.  
  25. VAR
  26.    Transfer_Kind : Transfer_Type;
  27.    Transfer_Menu : Menu_Type;
  28.    I             : INTEGER;
  29.    Pacing_String : STRING[1];
  30.    Ch            : CHAR;
  31.    Flag          : BOOLEAN;
  32.  
  33. BEGIN (* Get_Upload_Protocol *)
  34.  
  35.    Get_Upload_Protocol := None;
  36.  
  37.    WITH Transfer_Menu DO
  38.       BEGIN
  39.  
  40.          Menu_Size    := 9;
  41.  
  42.          Menu_Default := ORD( Default_Transfer_Type ) + 1;
  43.          IF Menu_Default > 9 THEN Menu_Default := 1;
  44.  
  45.          Menu_Row     := 4;
  46.          Menu_Column  := 20;
  47.          Menu_Tcolor  := Menu_Text_Color;
  48.          Menu_Bcolor  := BackGround_Color;
  49.          Menu_Fcolor  := Menu_Frame_Color;
  50.          Menu_Width   := 50;
  51.          Menu_Height  := 20;
  52.  
  53.       END;
  54.  
  55.    FOR I := 1 TO 9 DO
  56.       WITH Transfer_Menu.Menu_Entries[I] DO
  57.       BEGIN
  58.          Menu_Item_Row    := I;
  59.          Menu_Item_Column := 2;
  60.          CASE I OF
  61.             1:  Menu_Item_Text := 'a) Ascii';
  62.             2:  Menu_Item_Text := 'b) Xmodem (Checksum)';
  63.             3:  Menu_Item_Text := 'c) Xmodem (CRC)';
  64.             4:  Menu_Item_Text := 'd) Kermit';
  65.             5:  Menu_Item_Text := 'e) Telink';
  66.             6:  Menu_Item_Text := 'f) Modem7 (Checksum)';
  67.             7:  Menu_Item_Text := 'g) Modem7 (CRC)';
  68.             8:  Menu_Item_Text := 'h) Ymodem';
  69.             9:  Menu_Item_Text := 'i) Ymodem (Batch)';
  70.          END (* Case *);
  71.       END;
  72.  
  73.    Transfer_Menu.Menu_Title := 'Choose file transfer protocol for upload:';
  74.  
  75.    Menu_Display_Choices( Transfer_Menu );
  76.    Transfer_Kind := Transfers[ Menu_Get_Choice( Transfer_Menu ,
  77.                                                 Dont_Erase_Menu ) ];
  78.  
  79.    IF ( Transfer_Kind <> Kermit ) THEN
  80.       BEGIN
  81.          GoToXY( 2 , 11 );
  82.          WRITE('Filename.Ext ? ');
  83.          READLN(FileName);
  84.       END;
  85.  
  86.    Default_Transfer_Type := Transfer_Kind;
  87.  
  88.    IF Transfer_Kind IN [ Xmodem_Chk, Xmodem_Crc, Ascii, Ymodem ] THEN
  89.       BEGIN
  90.  
  91.          ASSIGN(AFile,FileName);
  92.             (*$I- *)
  93.          RESET(AFile);
  94.             (*$I+ *)
  95.  
  96.          IF Int24Result <> 0 THEN
  97.             BEGIN
  98.                Transfer_Kind := None;
  99.                WRITELN('*** File to send doesn''t exist, upload cancelled ***');
  100.             END;
  101.  
  102.       END;
  103.                                    (* Get delays for Ascii transfers *)
  104.    Char_Delay := 0;
  105.    Line_Delay := 0;
  106.  
  107.    CASE Transfer_Kind OF
  108.  
  109.       Xmodem_Crc,
  110.       Xmodem_Chk,
  111.       Ymodem      :     (*$I-*)
  112.                      CLOSE( AFile );
  113.                         (*$I+*)
  114.  
  115.       Ascii       :  BEGIN
  116.  
  117.                         GoToXY( 2 , 12 );
  118.                         WRITE('Delay between characters (milliseconds)? ');
  119.                         READLN( Char_Delay );
  120.  
  121.                         GoToXY( 2 , 13 );
  122.                         WRITE('Delay between lines (milliseconds)?      ');
  123.                         READLN( Line_Delay );
  124.  
  125.                         GoToXY( 2 , 14 );
  126.                         WRITE('Pacing character?                        ');
  127.                         READLN( Pacing_String );
  128.  
  129.                         IF LENGTH( Pacing_String ) > 0 THEN
  130.                            Pacing_Char := Pacing_String[1]
  131.                         ELSE
  132.                            Pacing_Char := CHR( NUL );
  133.  
  134.                         REPEAT
  135.                            GoToXY( 2 , 15 );
  136.                            WRITE('End each line with  a) CR or  b) CR+LF   ');
  137.                            ClrEol;
  138.                            READ( Kbd , Ch );
  139.                            WRITE( Ch );
  140.                            Ch := UpCase( Ch );
  141.                         UNTIL( Ch IN ['A','B'] );
  142.  
  143.                         IF Ch = 'A' THEN
  144.                            CR_LF_String := CHR( CR )
  145.                         ELSE
  146.                            CR_LF_String := CHR( CR ) + CHR( LF );
  147.  
  148.                         GoToXY( 2 , 15 );
  149.                         Ascii_Use_CtrlZ := YesNo(' Send Ctrl-Z at end of file? ');
  150.  
  151.                         GoToXY( 2 , 16 );
  152.                         Ascii_Show_Text := YesNo(' Display text during transfer? ');
  153.  
  154.                         GoToXY( 2 , 17 );
  155.                         Ascii_Send_Blank := YesNo(' Send empty line as a blank? ');
  156.  
  157.                         GoToXY( 2 , 19 );
  158.                         WRITE(' Hit ALT-S to stop transfer.');
  159.  
  160.                            (*$I-*)
  161.                         CLOSE( Afile );
  162.                            (*$I+*)
  163.  
  164.                      END;
  165.  
  166.       None        : ;
  167.  
  168.       ELSE        ;
  169.  
  170.    END (* CASE *);
  171.  
  172.                                    (* Return transfer protocol type *)
  173.    Get_Upload_Protocol := Transfer_Kind;
  174.  
  175.    DELAY( Two_Second_Delay );
  176.                                    (* Remove this window            *)
  177.    Restore_Screen( Saved_Screen );
  178.  
  179.    Reset_Global_Colors;
  180.  
  181. END   (* Get_Upload_Protocol *);
  182.